;; protocol/open-sound-control.scm - (c) rohan drape, 2002-2005

;; OSC is the Open Sound Control protocol.  See
;; <http://cnmat.berkley.edu/OSC> for details.

;; Requires the u8vector host procedures; the list library SRFI-1
;; (for procedure find-tail); and the string library SRFI-13 (for
;; procedures substring and string-index).

;; The following user-level procedures are adequate for normal use:
;; 'osc-encode-packet', which encodes a scheme OSC packet into a
;; binary OSC <u8vector>; 'osc-decode-packet', which does the
;; reverse; 'osc-verify-packet' which ensures that a scheme OSC packet
;; is syntactically correct; 'osc-purify' which rewrites scheme
;; <symbol>s as scheme <string>s and scheme <boolean>s as the
;; <integer>s zero and one; and 'osc-display-packet', which prints a
;; human readable text representation of a binary encoded OSC packet.

;; Scheme Representation: A scheme OSC packet can take two forms.  A
;; list starting with a <string> is an 'OSC message', the subsequent
;; elements are arguments of type <integer>, <real> or <string>.  A
;; list starting with an <integer> is an OSC 'bundle', the subsequent
;; elements are either 'OSC message' <list>s or 'OSC bundle' <list>s.

;; Returns the number of bytes needed to store the <string> `s'.

(define (osc-string-storage-size s)
  (let ((n (string-length s)))
    (+ n (- 4 (modulo n 4)))))

;; Returns #t iff the lisp OSC packet `p' is a lisp OSC message.

(define (osc-lisp-message? p)
  (string? (car p)))

;; Returns #t iff the lisp OSC packet `p' is a list OSC bundle.

(define (osc-lisp-bundle? p)
  (integer? (car p)))

;; Evaluates to a type-correct form of the OSC data `e'.  This
;; procedure does not verify that `e' is syntactically correct.
;; Boolean values are rewritten as integers, zero for '#f' and one for
;; '#t'.  Symbols are rewritten as the strings given by
;; 'symbol->string'.  An error is raised if `e' cannot be rewritten.
;; Note that R5RS does not require symbols to be case sensitive
;; although most interpreters will have an option to set this.

(define (osc-purify e)
  (cond ((or (number? e) (string? e) (u8vector? e)) e)
	((list? e) (map osc-purify e))
	((symbol? e) (symbol->string e))
	((boolean? e) (if e 1 0))
	(else (error "osc-purify: illegal input" e))))

;; Evaluates to '#t' iff `m' is a correct OSC message.  The first
;; element must be a string 'address', subsequent elements are
;; arguments of types integer, real or string.

(define (osc-verify-message m)
  (and (string? (car m))
       (not (find-tail (lambda (e) (not (or (integer? e)
					    (real? e)
					    (string? e))))
		       (cdr m)))))

;; Evaluates to '#t' iff `b' is a correct OSC bundle.  The first
;; element must be an integer 'timetag', subsequent elements may be OSC
;; messages or OSC bundles.  The timetags of embedded bundles must be
;; greater than or equal to the timetag of the containing bundle.

(define (osc-verify-bundle b)
  (and (integer? (car b))
       (not (find-tail (lambda (e) (not (or (osc-verify-message e)
					    (and (osc-verify-bundle e)
						 (>= (car e) (car b))))))
		       (cdr b)))))

;; Evaluates to '#t' iff `p' is a correct OSC packet.  An OSC packet
;; is either an OSC message or an OSC bundle.

(define (osc-verify-packet p)
  (or (osc-verify-message p)
      (osc-verify-bundle p)))

;; Write a text representation of the OSC byte string `s' to
;; `output-port'.  The display format is that used throughout the OSC
;; specification.

(define (osc-display-packet s output-port)
  (do ((length (u8vector-length s))
       (n 0 (+ n 1)))
      ((= n length))
    (let ((i (u8vector-ref s n)))
      (display (format "~a (~a)" (number->string i 16) (integer->char i))
	       output-port)
      (if (= 3 (modulo n 4))
	  (newline output-port)
	  (display #\space output-port)))))

;; Return the storage size of the argument `type'.  For string and
;; u8vector arguments the data must be accessed to determine this
;; value.

(define (osc-value-storage-size type data offset)
  (case type
    ((#\i #\f) 
     4)
    ((#\t #\h #\d) 
     8)
    ((#\s) 
     (let ((n (u8vector-index data 0 offset)))
       (+ n (- 4 (modulo n 4)))))
    ((#\b) 
     (+ (decode-int32 (u8vector-copy data offset (+ offset 4))) 4))
    (else
     (error "osc-value-storage-size" type data))))

;; Evaluate to the list of storage sizes for the objects encoded in
;; the OSC <u8vector> `data' conforming to the types given in the
;; OSC character type list `type-descriptor'.

(define (osc-message-indices type-descriptor data)
  (error "not implemented"))

